home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Moscow ML 1.42 / src / mosmllib / Lexing.sml < prev    next >
Encoding:
Text File  |  1997-08-18  |  3.3 KB  |  96 lines  |  [TEXT/R*ch]
  1. (* The run-time library for lexers generated by mosmllex *)
  2.  
  3. open Obj;
  4.  
  5. datatype lexbuf = LEXBUF of
  6.   (* refillBuff *)     (lexbuf -> unit) *
  7.   (* lexBuffer *)      string *
  8.   (* lexAbsPos *)      int *
  9.   (* lexStartPos *)    int *
  10.   (* lexCurrPos *)     int *
  11.   (* lexLastPos *)     int *
  12.   (* lexLastAction *)  (lexbuf -> obj)
  13. ;
  14.  
  15. prim_val getRefillBuff    : lexbuf -> (lexbuf -> unit) = 1 "field0";
  16. prim_val getLexBuffer     : lexbuf -> string           = 1 "field1";
  17. prim_val getLexAbsPos     : lexbuf -> int              = 1 "field2";
  18. prim_val getLexStartPos   : lexbuf -> int              = 1 "field3";
  19. prim_val getLexCurrPos    : lexbuf -> int              = 1 "field4";
  20. prim_val getLexLastPos    : lexbuf -> int              = 1 "field5";
  21. prim_val getLexLastAction : lexbuf -> (lexbuf -> obj)  = 1 "field6";
  22.  
  23. prim_val setRefillBuff    : lexbuf -> (lexbuf -> unit) -> unit = 2 "setfield0";
  24. prim_val setLexBuffer     : lexbuf -> string -> unit           = 2 "setfield1";
  25. prim_val setLexAbsPos     : lexbuf -> int -> unit              = 2 "setfield2";
  26. prim_val setLexStartPos   : lexbuf -> int -> unit              = 2 "setfield3";
  27. prim_val setLexCurrPos    : lexbuf -> int -> unit              = 2 "setfield4";
  28. prim_val setLexLastPos    : lexbuf -> int -> unit              = 2 "setfield5";
  29. prim_val setLexLastAction : lexbuf -> (lexbuf -> obj) -> unit  = 2 "setfield6";
  30.  
  31. prim_val create_string_ : int -> string                 = 1 "create_string";
  32. prim_val nth_char_      : string -> int -> char         = 2 "get_nth_char";
  33. prim_val set_nth_char_  : string -> int -> int -> unit  = 3 "set_nth_char";
  34. prim_val blit_string_   : string -> int -> string -> int -> int -> unit
  35.                                                         = 5 "blit_string"
  36.  
  37. val lexAuxBuffer = create_string_ 1024;
  38. val charBuffer = magic(ref lexAuxBuffer) : CharArray.array;
  39.  
  40. fun lexRefill readFun lexbuf =
  41.   let
  42.     val read = readFun charBuffer 1024
  43.     val n = if read > 0 then read
  44.             else (set_nth_char_ lexAuxBuffer 0 0; 1)
  45.   in
  46.     blit_string_ (getLexBuffer lexbuf) n (getLexBuffer lexbuf) 0 (2048 - n);
  47.     blit_string_ lexAuxBuffer 0 (getLexBuffer lexbuf) (2048 - n) n;
  48.     setLexAbsPos lexbuf (getLexAbsPos lexbuf + n);
  49.     setLexCurrPos lexbuf (getLexCurrPos lexbuf - n);
  50.     setLexStartPos lexbuf (getLexStartPos lexbuf - n);
  51.     setLexLastPos lexbuf (getLexLastPos lexbuf - n);
  52.     if getLexStartPos lexbuf < 0 then
  53.       raise Fail "lexing: token too long"
  54.     else ()
  55.   end
  56. ;
  57.  
  58. fun dummyAction x = raise Fail "lexing: empty token";
  59.  
  60. fun createLexer f = LEXBUF
  61.   (lexRefill f, create_string_ 2048, ~2048, 2048, 2048, 2048, dummyAction)
  62. ;
  63.  
  64. fun createLexerString s = LEXBUF
  65.   ( fn lexbuf => setLexCurrPos lexbuf (getLexCurrPos lexbuf - 1),
  66.     s ^ "\000", 0, 0, 0, 0, dummyAction )
  67. ;
  68.  
  69. fun getLexeme lexbuf =
  70.   let
  71.     val len = getLexCurrPos lexbuf - getLexStartPos lexbuf
  72.     val s = create_string_ len
  73.   in
  74.     blit_string_ (getLexBuffer lexbuf) (getLexStartPos lexbuf) s 0 len; s
  75.   end
  76. ;
  77.  
  78. fun getLexemeChar lexbuf i =
  79.   nth_char_ (getLexBuffer lexbuf) (getLexStartPos lexbuf + i)
  80. ;
  81.  
  82. fun backtrack lexbuf =
  83.   (setLexCurrPos lexbuf (getLexLastPos lexbuf);
  84.    magic_obj ((getLexLastAction lexbuf) lexbuf))
  85. ;
  86.  
  87. fun getLexemeStart lexbuf =
  88.   getLexAbsPos lexbuf + getLexStartPos lexbuf
  89. ;
  90.  
  91. fun getLexemeEnd lexbuf =
  92.   getLexAbsPos lexbuf + getLexCurrPos lexbuf
  93. ;
  94.  
  95. prim_val getNextChar : lexbuf -> char = 1 "get_next_char";
  96.